subroutine r2abij_t2efij_iefab_ri2(r2, t2, &
              icore, fact, rivv, ig, giop)
!
use mod_ri
use mod_size
use mod_iop
use mod_orbit
use mod_ioff
use mod_symm
implicit none
!
integer, intent(in) :: giop(5)
real*8, intent(in) :: fact
real*4, intent(in) :: r2(*)
!
real*4, intent(inout) :: t2(*), icore(*), rivv(*)
real*4, intent(inout), device :: ig(*)
!
integer :: i, j, a, b, nsize, i0, i1, itmp0, itmp1, itmp2
integer :: i0g, i1g, i2g, i3g, i4g, i5g, i6g, i2, i3, nvvo
integer :: irrep
integer, external :: idsymsoc
real*8, external :: dnrm2, nrm2so
!this is to do r2 = r2 + 0.5*t2(efij)*iefab
itmp0 = 1
itmp1 = itmp0 + nioiri_vv1*isd
itmp2 = itmp1 + nioiri_vv2*isd
i0 = itmp2

nvvo = 1
do irrep = 1, nirrep
    nvvo = max(nvvo, idsymsoc(irrep, vrta, vrta, 1, popa, zorb, 1), &
                 idsymsoc(irrep, vrtb, vrtb, 1, popa, zorb, 1), &
                 idsymsoc(irrep, vrta, vrta, 1, popb, zorb, 1), &
                 idsymsoc(irrep, vrtb, vrtb, 1, popb, zorb, 1))
enddo
i0 = 1 
i1 = i0 + nvvoo*isd
! AAAA
if(giop(3)==2) then 
 igpu = 1
 i0g = 1
 i1g = i0g + nioi31*isd
 i2g = i1g + nioiri_vv1*isd
 i3g = i2g + nioi31*isd
 i4g = i3g + nvvv*isd*2
 call myicopy_g(t2(ioi3(1))      , ig(i0g), nioi31    )
 call myicopy_g(rivv(ioiri_vv(1)), ig(i1g), nioiri_vv1)
 call VmnpqVmnrs_to_Vpqrs_uri_vv2(ig(i0g), ig(i3g), 1, 1, vrta, vrta, 0, &
                popa, popa, 0, vrta, vrta, 0, ig(i2g), 1, 1.d0, 0.d0, & 
                ig(i1g), ig(i1g), 1) 
 igpu = 0
 call myicopy_c(ig(i2g), icore(i0), nvvoo)
elseif(giop(3)==3) then 
 igpu = 1
 i0g = 1
 i1g = i0g + nvvo*isd 
 i2g = i1g + nioiri_vv1*isd
 i3g = i2g + nvvo*isd
 i4g = i3g + nvvv*isd*2
 call myicopy_g(rivv(ioiri_vv(1)), ig(i1g), nioiri_vv1)
 call VmnpqVmnrs_to_Vpqrs_uri_vv_l(ig(i0g), ig(i3g), 1, 1, vrta, vrta, 0, &
                popa, popa, 0, vrta, vrta, 0, ig(i2g), 1, 1.d0, 0.d0, & 
                ig(i1g), t2(ioi3(1)), icore(i0), icore(i1), rivv(ioiri_vv(1)), 1) 
 igpu = 0
else 
 write(6,*)'error in calciabcd_ri2'
 stop
endif
!call VmnpqVmnrs_to_Vpqrs_uri_vv2(t2(ioi3(1)), icore(i1), 1, 1, vrta, vrta, 0, &
!               popa, popa, 0, vrta, vrta, 0, icore(i0), 1, 1.d0, 0.d0, & 
!               rivv(ioiri_vv(1)), rivv(ioiri_vv(1)), 1) 
call itranspso(icore(i0), icore(i1), popa, popa, 0, vrta, vrta, 0, 1) 
call axpyso(nioi31, fact*2.d0, icore(i1), 1, r2(ioi3(1)), 1)
! ABAB  
if(giop(3)==2) then 
 igpu = 1
 i0g = 1
 i1g = i0g + nioi32*isd
 i2g = i1g + nioiri_vv1*isd
 i3g = i2g + nioiri_vv2*isd
 i4g = i3g + nioi32*isd
 i4g = i3g + nvvv*isd*2
 call myicopy_g(t2(ioi3(2))      , ig(i0g), nioi32    )
 call myicopy_g(rivv(ioiri_vv(1)), ig(i1g), nioiri_vv1)
 call myicopy_g(rivv(ioiri_vv(2)), ig(i2g), nioiri_vv2)
 call VmnpqVmnrs_to_Vpqrs_uri_vv2(ig(i0g), ig(i4g), 1, 1, vrta, vrtb, 1, &
               popa, popb, 1, vrta, vrtb, 1,  ig(i3g), 1, 1.d0, 0.d0, &
               ig(i1g), ig(i2g), 3) 
 igpu = 0
 call myicopy_c(ig(i3g), icore(i0), nvvoo)
elseif(giop(3)==3) then 
 igpu = 1
 i0g = 1
 i1g = i0g + nvvo*isd 
 i2g = i1g + nioiri_vv1*isd
 i3g = i2g + nvvo*isd
 i4g = i3g + nvvv*isd*2
 call myicopy_g(rivv(ioiri_vv(1)), ig(i1g), nioiri_vv1)
 call VmnpqVmnrs_to_Vpqrs_uri_vv_l(ig(i0g), ig(i3g), 1, 1, vrta, vrtb, 1, &
               popa, popb, 1, vrta, vrtb, 1,  ig(i2g), 1, 1.d0, 0.d0, &
               ig(i1g), t2(ioi3(2)), icore(i0), icore(i1), rivv(ioiri_vv(2)), 3)
 igpu = 0
! call myicopy_c(ig(i3g), icore(i0), nvvoo)
else
 write(6,*)'error in calciabcd_ri2'
 stop
endif 
!call VmnpqVmnrs_to_Vpqrs_uri_vv2(t2(ioi3(2)), icore(i1), 1, 1, vrta, vrtb, 1, &
!               popa, popb, 1, vrta, vrtb, 1,  icore(i0), 1, 1.d0, 0.d0, &
!               rivv(ioiri_vv(1)), rivv(ioiri_vv(2)), 3) 
call itranspso(icore(i0), icore(i1), popa, popb, 1, vrta, vrtb, 1, 1) 
call axpyso(nioi32, fact*2.d0, icore(i1), 1, r2(ioi3(2)), 1)
! BBBB    
if(giop(3)==2) then 
 igpu = 1
 i0g = 1
 i1g = i0g + nioi33*isd
 i2g = i1g + nioiri_vv2*isd
 i3g = i2g + nioi33*isd
 i4g = i3g + nvvv*isd*2
 call myicopy_g(t2(ioi3(3))      , ig(i0g), nioi33    )
 call myicopy_g(rivv(ioiri_vv(2)), ig(i1g), nioiri_vv2)
 call VmnpqVmnrs_to_Vpqrs_uri_vv2(ig(i0g), ig(i3g), 1, 1, vrtb, vrtb, 0, &
                popb, popb, 0, vrtb, vrtb, 0, ig(i2g), 1, 1.d0, 0.d0, &
                ig(i1g), ig(i1g), 2) 
 igpu = 0
 call myicopy_c(ig(i2g), icore(i0), nvvoo)
elseif(giop(3)==3) then 
 igpu = 1
 i0g = 1
 i1g = i0g + nvvo*isd 
 i2g = i1g + nioiri_vv2*isd
 i3g = i2g + nvvo*isd
 i4g = i3g + nvvv*isd*2
 call myicopy_g(rivv(ioiri_vv(2)), ig(i1g), nioiri_vv2)
 call VmnpqVmnrs_to_Vpqrs_uri_vv_l(ig(i0g), ig(i3g), 1, 1, vrtb, vrtb, 0, &
                popb, popb, 0, vrtb, vrtb, 0, ig(i2g), 1, 1.d0, 0.d0, &
                ig(i1g), t2(ioi3(3)), icore(i0), icore(i1), rivv(ioiri_vv(2)),  2) 
 igpu = 0
else 
 write(6,*)'error in calciabcd_ri2'
 stop
endif
!call VmnpqVmnrs_to_Vpqrs_uri_vv2(t2(ioi3(3)), icore(i1), 1, 1, vrtb, vrtb, 0, &
!               popb, popb, 0, vrtb, vrtb, 0, icore(i0), 1, 1.d0, 0.d0, &
!               rivv(ioiri_vv(2)), rivv(ioiri_vv(2)), 2) 
call itranspso(icore(i0), icore(i1), popb, popb, 0, vrtb, vrtb, 0, 1) 
call axpyso(nioi33, fact*2.d0, icore(i1), 1, r2(ioi3(3)), 1)
!
return
end
